home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / icon / packages.lha / packages / atari / ats.arc / TESTS.ARC / MFFSOL.ICN < prev    next >
Text File  |  1990-03-28  |  3KB  |  115 lines
  1. ##  mffsol.icn -- show solution graphically in mff format
  2. #
  3. #   input is assumed to be one line per round
  4. #   each player is represented by a different ASCII character
  5. #   matches are broken by whitespace
  6.  
  7. global range                # vertical coordinate range
  8. global red, green, blue            # current color
  9.  
  10. procedure main (args)
  11.     range := 1000
  12.     aset := cset(&cset[34:128])    # set of usable ascii characters
  13.     pset := ''                # set of chars in use as players
  14.     plist := ""                # same, in order of appearance
  15.     rounds := []            # list of rounds (one text line each)
  16.     nmatches := 0
  17.  
  18.     if *args > 0 then
  19.     f := open(args[1]) | stop("can't open ",args[1])
  20.     else
  21.     f := &input
  22.  
  23.     # read input and save in memory
  24.     # (this first pass just accumulates a list of players)
  25.     while line := read(f) do
  26.     if line[1] ~== "[" & upto(aset,line) then {
  27.         put(rounds,line)
  28.         line ? while tab(upto(aset)) do {
  29.         c := move(1)
  30.         if not any(pset,c) then { # if first appearance of new player
  31.             pset ++:= c        # add to set of players
  32.             plist ||:= c    # add at end of list
  33.         }
  34.         }
  35.     }
  36.  
  37.     # if all the characters are letters, arrange alphabetically
  38.     if *(plist -- &ucase -- &lcase) = 0 then
  39.     plist := string(cset(plist))
  40.  
  41.     #  calculate a position (angle) for each player, and draw the clock face
  42.     write("1 metafile ", pct(125), " ", pct(100), " 0 0 0 init")
  43.     angle := table()
  44.     dtheta := 2 * 3.14159 / *pset
  45.     theta := 3.14159 / 2 - dtheta / 2
  46.     every c := !plist do {
  47.     angle[c] := theta
  48.     cart(47, theta, -1, -1)
  49.     write("(",c,") text")
  50.     theta -:= dtheta
  51.     }
  52.  
  53.     # draw each round in a different color
  54.     n := 1
  55.     red := 250
  56.     green := 255
  57.     blue := 0
  58.     every r := !rounds do {
  59.     write(red, " ", green, " ", blue, " color")
  60.     x := pct(110)
  61.     y := pct(100 - 4 * n)
  62.     if y > 0 then
  63.         write(x, " ", y, " (", n, ") text")
  64.     r ? while tab(upto(aset)) do {
  65.         match := tab(many(aset))
  66.         cart (45, angle[match[1]], 0, 0);  writes ("begin ")
  67.         cart (45, angle[match[2]], 0, 0);  writes ("line ")
  68.         cart (45, angle[match[3]], 0, 0);  writes ("line ")
  69.         cart (45, angle[match[4]], 0, 0);  writes ("line ")
  70.         cart (45, angle[match[1]], 0, 0);  write  ("line")
  71.         cart (45, angle[match[3]], 0, 0);  writes ("line stroke ")
  72.         cart (45, angle[match[2]], 0, 0);  writes ("begin ")
  73.         cart (45, angle[match[4]], 0, 0);  write  ("line stroke")
  74.         nmatches +:= 1
  75.     }
  76.     n +:= 1
  77.     newcolor()
  78.     }
  79.  
  80.     # write some final statistics
  81.     write ("255 255 255 color")
  82.     write ("0 0 (",
  83.     *pset," players, ",*rounds," rounds, ",nmatches," matches) text")
  84.     end
  85.  
  86.  
  87. # given polar coordinates (radius,angle,dx,dy), write cartesian equivalents 
  88. # offset by (dx,dy)
  89.  
  90. procedure cart (r,a,dx,dy)
  91.     x := pct (50 + r * cos(a) + dy)
  92.     y := pct (50 + r * sin(a) + dy)
  93.     writes (x," ",y," ")
  94.     end
  95.  
  96.  
  97. # return a string representing a given percentage of the coordinate range
  98.  
  99. procedure pct (n)
  100.     return string(integer(n * range / 100))
  101.     end
  102.  
  103.  
  104. # set new color coordinates.  iterate until acceptable.
  105.  
  106. procedure newcolor()
  107.     repeat {
  108.     red := (red + 103) % 256
  109.     green := (green + 211) % 256
  110.     blue := (blue + 71) % 256
  111.     lum := 0.30 * red + 0.59 * green + 0.11 * blue
  112.     if lum > 96 then return
  113.     }
  114.     end
  115.